Computer Select (Limited Edition)/Computer Select.iso/dobbs/v16n07/vga.asc

Text File | 1991-06-11 | 18.0 KB | 535 lines

_SAVING AND RESTORING VGA SCREENS_
by Ben Myers

[LISTING ONE]

  PAGE 80,132
  TITLE EGA/VGA screen save/restore  (Turbo Pascal 4.0+ or Quick Pascal 1.0)
; GRFSAVE.ASM -
;  (C)Copyright 1989-1990 Spirit of Performance, Inc.
;  All rights reserved. Unauthorized use or copying prohibited by law.

CODE   SEGMENT WORD PUBLIC
       ASSUME  CS:CODE
       PUBLIC  Write_VGA_Plane ; Write video plane from caller's memory.
       PUBLIC  Read_VGA_Plane  ; Read video plane, move it to caller's memory.

; procedure Write_VGA_Plane (Plane, Count : word; var Plane_Array );
; procedure Read_VGA_Plane  (Plane, Count : word; var Plane_Array );
; Parameters:  Plane       - Graphics plane number to move ( range 0-3 )
;           Count       - Byte count to move
;              Plane_Array - Array for video plane values

Plane_Array  EQU  DWORD PTR [bp+06h]
Count          EQU  WORD  PTR [bp+0Ah]
Plane          EQU  WORD  PTR [bp+0Ch]

Write_VGA_Plane PROC FAR
       push  bp                 ; Save Turbo's BP
       mov   bp,sp              ; Set up stack frame
       mov   bx,ds              ; Save Turbo's DS
       mov   di,0A000h          ; EGA/VGA buffer segment:offset, A000:0000
       mov   es,di
       xor   di,di              ; ES:DI is start of video buffer
       mov   dx,3CEh            ; DX = Graphics Controller I/O Port
       mov   ax,0005h           ; AH = 00h (Read mode 0, write mode 0)
                ; AL = Mode register number (5)
       out   dx,ax              ; load Mode register
       mov   ax,0001h           ; AH = 00h (mask for Enable Set/Reset),
                ; also the default for modes 12h and 10h
                ; AL = Enable Set/Reset register number (1)
       out   dx,ax              ; load Enable Set/Reset register
       mov   ax,0003h           ; AH = Replace bit planes with memory,
                ; no bit rotation, also the default
                ; AL = Data Rotate/Function Select register
                ; number (3)
       out   dx,ax              ; load Data Rotate/Function Select register
                ; AL = Bit Mask Register (8)
       mov   ax,0FF08h          ; AH = bit mask
       out   dx,ax              ; Set bit mask register for all bits
       mov   dx,3C4h            ; DX = Sequencer I/O Port
       mov   cx,ss:Plane        ; Get Plane number from caller
       and   cl,03h             ; Force it to range 0 to 3
       mov   ah,1               ; Set up AH with bit number of plane to restore
       shl   ah,cl              ; where bit 0 = plane 0, etc.
       mov   al,02h             ; AL = Map Mask Register number (2)
       out   dx,ax              ; load Map Mask register with plane number
       mov   cx,ss:Count        ; byte count to move (size of plane for
                ; EGA/VGA card in current mode )
       lds   si,ss:Plane_Array  ; Addr of array to restore plane values from
       rep movsb                ; Move the data
; Or replace the above instruction by the slower but equivalent loop construct
; below in the event that your VGA card doesn't respond properly.
@@:
;       lodsb                    ; Get a byte from save area plane
;       stosb                    ; Form a byte for current plane
;       loop  @B                 ; Do next byte, until all have been done.

; Now reset the VGA registers used back to the defaults expected.
       mov   dx,3CEh            ; DX = Graphics Controller I/O Port
       mov   ax,0001            ; AH = 0 (default Enable Set/Reset Value)
                ; AL = Enable Set/Reset register number (1)
       out   dx,ax              ; restore default Enable Set/Reset register
       mov   dx,3C4h            ; DX = Sequencer I/O port
                ; AH = all planes enabled
       mov   ax,0F02h           ; AL = Map Mask Register number (2)
       out   dx,ax              ; restore Map Mask register to do all planes.
       mov   ds,bx              ; Restore Turbo's DS
       pop   bp                 ; Restore Turbo's BP
       ret   8                  ; Remove params & return to call
Write_VGA_Plane ENDP

; procedure Read_VGA_Plane (Plane, Count : word; var Plane_Array );

Read_VGA_Plane PROC FAR
       push  bp                 ; Save Turbo's BP
       mov   bp,sp              ; Set up stack frame
       mov   bx,ds              ; Save Turbo's DS
       mov   si,0A000h          ; EGA/VGA buffer segment:offset, A000:0000
       mov   ds,si
       xor   si,si              ; DS:SI is start of video buffer
       mov   dx,3CEh            ; DX = Graphics Controller I/O Port
       mov   ax,0005h           ; AH = 00h (Read mode 0, write mode 0)
                ; AL = 5 (Mode register number)
       out   dx,ax              ; load Mode register
;;     int   3            ; Enable breakpoint for debugging.
       mov   ax,ss:Plane        ; Get Plane number
       mov   ah,al              ; AH = color plane to get
       mov   al,04h            ; AL = Read Map Select Register number (4)
       out   dx,ax            ; load Read Map Select register
       mov   cx,ss:Count        ; byte count to move (size of plane for
                ; EGA/VGA card in current mode )
       les   di,ss:Plane_Array  ; Address of array to store plane values.
       rep movsb                ; Move the data from video buffer to save area
; Or replace the above instruction by the slower but equivalent loop construct
; below in the event that your VGA card doesn't respond properly.
@@:
;       lodsb                    ; Get a byte from plane of video buffer
;       stosb                    ; Save it.
;       loop  @B                 ; Do next byte, until all have been done.

; Now reset the VGA registers used back to the defaults expected.
       mov   ax,1005h           ; AH = 10h, defaults for modes 12h and 10h
                ; AL = Mode register number (5)
       out   dx,ax              ; restore default mode register
       mov   ax,0004h            ; AL = Read Map Select Register number (4)
       out   dx,ax            ; load Read Map Select register default value
       mov   ds,bx              ; Restore Turbo's DS
       pop   bp                 ; Restore Turbo's BP
       ret   8                  ; Remove params & return to call
Read_VGA_Plane ENDP
CODE   ENDS
       END



[LISTING TWO]

{
 GRFSAVE1.PAS - Unit to save and restore graphics screens
 Version 1.40 (03-19-90)   --depends on MSgraph Unit for
              manifest constants indentifying graphics modes.
 procedure Write_VGA_Plane (Plane, Count : word; var Plane_Array );
 procedure Read_VGA_Plane  (Plane, Count : word; var Plane_Array );
 Parameters:  Plane       - Graphics plane number to move ( range 0-3 )
          Count       - Byte count to move
          Plane_Array - Array for video plane values
 (C)Copyright 1989-1990 Spirit of Performance, Inc.
 All rights reserved. Unauthorized use or copying prohibited by law.
}

{$R-,S-,I-,D+,F+,V-,B-,N-,L+ }

UNIT GRFSAVE;

INTERFACE
USES MsGraph;

const
  Max_Planes = 4;

procedure Init_Screen_Save ( Plane_Size : longint; Number_Of_Planes : word );
Function  HeapFunc ( Size: word ) : integer;
function  Save_Screen ( Mode : integer ) : integer;
procedure Restore_Screen;
procedure Write_VGA_Plane (Plane, Count : word; var Plane_Array );
procedure Read_VGA_Plane  (Plane, Count : word; var Plane_Array );

IMPLEMENTATION

var
{ Video plane size and number of planes in bytes }
{ ****** When video plane size gets above 64K, need to change below }
    Video_Plane_Size    : word;  { in bytes }
    Number_GPlanes      : word;
    Plane_Counter       : word;
    Plane_Ptrs          : array [1..Max_Planes] of pointer;
    Planes_Saved        : integer;
    Saved_Graphics_Mode : integer;
    Monochrome_Buffer   : ARRAY[ 0..$7FFF ] OF byte ABSOLUTE $B800:$0000;
    VGA_Buffer          : ARRAY[ 0..$7FFF ] OF byte ABSOLUTE $A000:$0000;

procedure Init_Screen_Save;
  { Initialize unit with parameters }
  begin
    Video_Plane_Size := Plane_Size;
    Number_GPlanes := Number_Of_Planes;
  end;

Function HeapFunc;
{ Simple heap error function overrides run time error to avoid program
  abort.  }
begin
  HeapFunc := 1;  { return an error indicator to caller }
end;

{$L d:\tpsource\GRFSAVE.obj }
procedure Write_VGA_Plane; external;
procedure Read_VGA_Plane;  external;

function Save_Screen;
{ Saves graphics planes for current graphics mode.
  Returns number of planes saved, in case caller cares.
}

  begin
    Saved_Graphics_Mode := Mode;
    Planes_Saved := 0;
    HeapError := @HeapFunc;
    case Saved_Graphics_Mode of
      _HRes16Color,    { 640 x 200, 16 color }
      _EResColor  ,    { 640 x 350, 4 or 16 color }
      _VRes16Color:    { 640 x 480, 16 color }
      for Plane_Counter := 1 to Number_GPlanes do
    begin
      { Get memory to save a plane }
      GetMem( Plane_Ptrs[Plane_Counter], Video_Plane_Size);
      if Plane_Ptrs[Plane_Counter] <> nil then
        { Move the plane if GetMem succeeded }
        begin
          Read_VGA_Plane (Plane_Counter-1, Video_Plane_Size,
                  Plane_Ptrs[Plane_Counter]^ );
          inc ( Planes_Saved );
        end;
    end;
      _HResBW  ,    { 640 x 200, BW }
      _HercMono:    { 720 x 348, BW for HGC }
    begin
      GetMem( Plane_Ptrs[1], Video_Plane_Size);
      if Plane_Ptrs[Plane_Counter] <> nil then
        begin
          Move ( Monochrome_Buffer, Plane_Ptrs[1]^, Video_Plane_Size );
          Planes_Saved := 1;
        end;
    end;
      _EResNoColor,    { 640 x 350, BW }
      _VRes2Color :    { 640 x 480, BW }
    begin
      GetMem( Plane_Ptrs[1], Video_Plane_Size);
      if Plane_Ptrs[Plane_Counter] <> nil then
        begin
          Move ( VGA_Buffer, Plane_Ptrs[1]^, Video_Plane_Size );
          Planes_Saved := 1;
        end;
    end;
    end; {case Saved_Graphics_Mode}
    if Planes_Saved <> Number_GPlanes then
      { Unsuccessful, so reset count of planes saved }
      Planes_Saved := 0;
    Save_Screen := Planes_Saved;
  end;

procedure Restore_Screen;
  begin
    if Planes_Saved <> 0 then
      case Saved_Graphics_Mode of
    _HRes16Color,    { 640 x 200, 16 color }
    _EResColor  ,    { 640 x 350, 4 or 16 color }
    _VRes16Color:    { 640 x 480, 16 color }
      for Plane_Counter := 1 to Number_GPlanes do
      if Plane_Ptrs[Plane_Counter] <> nil then
        Write_VGA_Plane (Plane_Counter-1, Video_Plane_Size,
                 Plane_Ptrs[Plane_Counter]^ );
    _HResBW  ,    { 640 x 200, BW }
    _HercMono:    { 720 x 348, BW for HGC }
      Move ( Plane_Ptrs[1]^, Monochrome_Buffer, Video_Plane_Size );
    _EResNoColor,    { 640 x 350, BW }
    _VRes2Color :    { 640 x 480, BW }
      Move ( Plane_Ptrs[1]^, VGA_Buffer, Video_Plane_Size );
      end; {case Saved_Graphics_Mode}
  end;
END.




[LISTING THREE]

PROGRAM savedemo;
{ savedemo.PAS - Demonstrate EGA/VGA graphics screen save/restore
  Version 1.00, 19 Mar 1990
  Uses for Microsoft Graphics Interface and selected MASM functions.
  (c)Copyright 1989-1990 Spirit of Performance, Inc.
}

USES
    DOS, MSGraph, Crt, GrfSave1;
type
  TimeRec = record
    Hour          : word;
    Minute        : word;
    Second        : word;
    FracSec       : word;
    Floating_Time : real;
end;

var
  Start_Time : TimeRec;
  Stop_Time  : TimeRec;

Function Elapsed_Time ( Stop_Time, Start_Time : TimeRec ) : real;

const
  R3600 : real = 3600.0;
  R60   : real = 60.0;
  R100  : real = 100.0;

begin   { Elapsed_Time }
  with Start_Time do
    begin
      Floating_Time := (Hour * R3600) + (Minute * R60) + Second
          + (FracSec / R100);
    end;
  if Stop_Time.Hour < Start_Time.Hour then inc(Stop_Time.Hour, 24);
  with Stop_Time do
    begin
      Floating_Time := (Hour * R3600) + (Minute * R60) + Second
          + (FracSec / R100);
    end;
  Elapsed_Time := Stop_Time.Floating_Time - Start_Time.Floating_Time;
end;    { Elapsed_Time }

TYPE
    ViewPortType = record
    x1, y1, x2, y2 : word;
    end;
VAR
    errorcode       : Integer;
    x,y             : Integer;
    maxx, maxy      : Integer; { Maximum addressable pixels }
    c               : Char;
    vc                 : _VideoConfig;
    CurrentView     : ViewPortType;
    lCount          : longint;
    OldExitProc     : Pointer;  { Saves exit procedure address }
    Plane_Count     : integer;
var
    Video_Plane_Size : longint;
    Number_GPlanes   : word;
CONST
    Version_ID     : string = ( 'Version 1.00, 19 Mar 1990' );
    Patterns       : Array [0..11] of _FillMask =
    (
     (0,0,0,0,0,0,0,0),
     ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF),
     ($FF, 0, $FF, 0, $FF, 0, $FF, 0),
     ($44, $88, $11, $22, $44, $88, $11, $22),
     ($77, $EE, $DD, $BB, $77, $EE, $DD, $BB),
     ($77, $BB, $DD, $EE, $77, $BB, $DD, $EE),
     ($88, $44, $22, $11, $88, $44, $22, $11),
     ($11, $AA, $44, $AA, $11, $AA, $44, $AA),
     ($55, $AA, $55, $AA, $55, $AA, $55, $AA),
     ($F0, $0F, $F0, $0F, $F0, $0F, $F0, $0F),
     (1, 0, 0, 0, 1, 0, 0, 0),
     (5, 0, 5, 0, 5, 0, 5, 0));

  CleanUp_Reqd : Boolean = TRUE;

{$F+}
procedure MyExitProc;
{ Procedure to clean up on early program termination }
begin
  ExitProc := OldExitProc; { Restore exit procedure address }
  if CleanUp_Reqd then
  begin    { Restore original video mode. }
    errorcode := _SetVideoMode( _DefaultMode );
  end;
end; { MyExitProc }
{$F-}

Procedure GetViewSettings (var ReqView : ViewPortType);
begin
    ReqView := CurrentView;
end;

Procedure SetView (xa, ya, xb, yb : word);
begin
  _SetViewPort(xa, ya, xb, yb);
  _SetClipRgn (xa, ya, xb, yb);
  with CurrentView do
    begin
      x1 := xa;  y1 := ya;
      x2 := xb;  y2 := yb;
    end;
end;

procedure FullPort;
{ Set the view port to the entire screen }
begin
  SetView(0, 0, maxx, maxy);
end; { FullPort }

procedure MainWindow(Header : string);

{ Make a default window and view port for demos }
begin
  _SetTextColor(vc.numcolors-1);           { Reset the colors }
  _SetBkColor(0);
  _SetColor(vc.numcolors-1);
  _ClearScreen(_GClearScreen);             { Clear the screen }
  FullPort;                                { Full screen view port }
  _SetTextPosition( 1, (vc.NumTextCols - length(Header)) div 2);
  _OutText(Header);        { Draw the header text }
  { Move the edges in to leave room for text at top and bottom }
  SetView(0, vc.NumYPixels div vc.NumTextRows + 1 , maxx,
           maxy-(vc.NumYPixels div vc.NumTextRows)-1);
end; { MainWindow }

procedure StatusLine(Msg : string);
{ Display a status line at the bottom of the screen }
begin
  FullPort;
  _SetLineStyle($FFFF);
  _SetFillMask(Patterns[0]);
  _SetColor(0);                   { Set the drawing color to black }
  _Rectangle(_GFillInterior,
        0, vc.NumYPixels-(vc.NumYPixels div vc.NumTextRows+1),
        maxx, maxy);     { Erase old status line }
  _SetTextPosition( vc.NumTextRows,
           (vc.NumTextCols - length(Msg)) div 2);
  _SetTextColor(vc.numcolors-1);  { Set the color for header }
  _SetBkColor(0);
  _OutText(Msg);        { Write the status message }
  { Go back to the main window }
   SetView(0, vc.NumYPixels div vc.NumTextRows +1 , vc.NumXPixels,
          vc.NumYPixels-(vc.NumYPixels div vc.NumTextRows+1));
  _SetTextPosition( 1, 1 );
end; { StatusLine }

procedure WaitToGo; { Wait for user to abort program or continue }
const
  Esc = #27;
var
  Ch : char;
begin
  StatusLine('Esc aborts or press a key...');
  with Start_Time do GetTime ( Hour, Minute, Second, FracSec );
  repeat
  with Stop_Time do GetTime ( Hour, Minute, Second, FracSec );
  { Wait for keypress no more then 5 seconds, then go on without it }
  until KeyPressed or (Elapsed_Time ( Stop_Time, Start_Time ) > 5.0);
  if Keypressed then
  begin
    Ch := ReadKey;
    if Ch = #0 then Ch := readkey;      { trap function keys }
    if Ch = Esc then
      Halt(0);                           { terminate program }
  end;
end; { WaitToGo }

procedure DrawRectangles;
{ Draw rectangles on the screen }
var
  MaxSize : word;
  XCenter, YCenter : word;
  ViewInfo  : ViewPortType;
  YMax, XMax : word;
  jCount : word;

begin  { DrawRectangles }
  MainWindow('Draw Rectangles');
  StatusLine('');
  GetViewSettings(ViewInfo);
  with ViewInfo do
  begin
    XMax := (x2-x1-1);
    YMax := (y2-y1-1);
  end;
  MaxSize := XMax shr 1;
  XCenter := XMax shr 1;
  YCenter := YMax shr 1;
  for lCount := 1 to MaxSize do
  begin
    _SetColor(lCount mod vc.numcolors);
    _Rectangle(_GBorder, XCenter+lCount, YCenter+lCount,
             XCenter-LCount, YCenter-LCount);
  end;
  WaitToGo;
end; { DrawRectangles }

procedure DrawCircles;
{ Draw concentric circles on the screen }
var
  MaxRadius : word;
  XCenter, YCenter : word;
  ViewInfo  : ViewPortType;
  YMax, XMax : word;

begin  { DrawCircles }
  MainWindow('Draw Circles');
  StatusLine('');
  GetViewSettings(ViewInfo);
  with ViewInfo do
  begin
    XMax := (x2-x1-1);
    YMax := (y2-y1-1);
  end;
  MaxRadius := XMax shr 1;
  XCenter := XMax shr 1;
  YCenter := YMax shr 1;
  for lCount := 1 to MaxRadius do
  begin
    _SetColor(lCount mod vc.numcolors);
    _Ellipse(_GBorder, XCenter + lCount, YCenter + lCount,
               XCenter - lCount, YCenter - lCount);
  end;
  WaitToGo;
end; { DrawCircles }

BEGIN
    OldExitProc := ExitProc;    { save previous exit proc }
    ExitProc := @MyExitProc;    { insert our exit proc in chain }
    _GetVideoConfig( vc );
    DirectVideo := FALSE;   { No direct writes allowed in graphics modes }

    { Set graphics mode with highest resolution. }
    if (_SetVideoMode( _MaxResMode) = 0) then
    Halt( 1 );
    _GetVideoConfig( vc );
    if vc.mode <> _HercMono then
      begin
    Video_Plane_Size := vc.numxpixels div 8;
    Video_Plane_Size := Video_Plane_Size * vc.numypixels;
      end
    else
      Video_Plane_Size := 32768;
    if vc.numcolors = 2 then
      Number_GPlanes := 1   { B&W modes have 1 plane only }
    else
      Number_GPlanes := 4;  { Assume that color modes have 4 planes }
    Init_Screen_Save (Video_Plane_Size, Number_GPlanes);

    _SetColor( vc.numcolors-1 );
    DrawRectangles;
    Plane_Count := Save_Screen (vc.mode); { Save the first screen }
    DrawCircles;
    Restore_Screen;                       { Restore the rectangles }
    WaitToGo;                             { Wait before terminating }

    { Restore original video mode. }
    errorcode := _SetVideoMode( _DefaultMode );
    CleanUp_Reqd := FALSE;
END.